home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / name.tcl < prev    next >
Encoding:
Text File  |  1997-05-27  |  3.0 KB  |  96 lines

  1. ##############################################################################
  2. # $Id: name.tcl,v 1.3 1997/05/28 02:34:05 stewart Exp $
  3. #
  4. # name.tcl - procedures for prompting widget names
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:get_name {type} {
  26.     global vTcl
  27.     set vTcl(x) ""
  28.     Window show .vTcl.name
  29.     focus .vTcl.name.ent18
  30.     grab .vTcl.name
  31.     wm title .vTcl.name "Naming new $type"
  32.     tkwait window .vTcl.name
  33.     if {[string first . $vTcl(x)] != -1} {
  34.         vTcl:error "Invalid widget name"
  35.         return ""
  36.     } else {
  37.         return $vTcl(x)
  38.     }
  39. }
  40.  
  41. proc vTcl:ok_new_widget {} {
  42.     global vTcl
  43.     set vTcl(x) [.vTcl.name.ent18 get]
  44.     grab release .vTcl.name
  45.     destroy .vTcl.name
  46. }
  47.  
  48. proc vTclWindow.vTcl.name {args} {
  49.     set base .vTcl.name
  50.     if {[winfo exists .vTcl.name]} {
  51.         wm deiconify .vTcl.name; return
  52.     }
  53.     toplevel .vTcl.name
  54.     wm focusmodel .vTcl.name passive
  55.     wm geometry .vTcl.name 225x49+288+216
  56.     wm maxsize .vTcl.name 500 870
  57.     wm minsize .vTcl.name 225 1
  58.     wm overrideredirect .vTcl.name 0
  59.     wm resizable .vTcl.name 1 0
  60.     wm deiconify .vTcl.name
  61.     wm title .vTcl.name "Name Widget"
  62.     bind .vTcl.name <Key-Return> {
  63.         vTcl:ok_new_widget
  64.     }
  65.     entry .vTcl.name.ent18 \
  66.         -cursor {}  
  67.     pack .vTcl.name.ent18 \
  68.         -in .vTcl.name -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
  69.         -padx 0 -pady 0 -side top 
  70.     frame .vTcl.name.fra19 \
  71.         -borderwidth 1 -height 30 -relief sunken -width 30 
  72.     pack .vTcl.name.fra19 \
  73.         -in .vTcl.name -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
  74.         -padx 0 -pady 0 -side top 
  75.     button .vTcl.name.fra19.but20 \
  76.         -command {
  77.             vTcl:ok_new_widget
  78.         } \
  79.          -padx 9 \
  80.         -pady 3 -text OK -width 5 
  81.     pack .vTcl.name.fra19.but20 \
  82.         -in .vTcl.name.fra19 -anchor center -expand 1 -fill x -ipadx 0 \
  83.         -ipady 0 -padx 0 -pady 0 -side left 
  84.     button .vTcl.name.fra19.but21 \
  85.         -command {
  86.             grab release .vTcl.name
  87.             destroy .vTcl.name
  88.         } \
  89.          -padx 9 \
  90.         -pady 3 -text Cancel -width 5 
  91.     pack .vTcl.name.fra19.but21 \
  92.         -in .vTcl.name.fra19 -anchor center -expand 1 -fill x -ipadx 0 \
  93.         -ipady 0 -padx 0 -pady 0 -side left 
  94. }
  95.  
  96.